home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / adirec1a / dx7sound.bas < prev    next >
Encoding:
BASIC Source File  |  1999-10-10  |  4.5 KB  |  116 lines
  1. Attribute VB_Name = "DX7Sound"
  2. Option Explicit
  3.  
  4. 'This module was created by D.R Hall
  5. 'For more Information and latest version
  6. 'E-mail me, derek.hall@virgin.net
  7.  
  8.  
  9. Private m_dx As New DirectX7
  10. Private m_dxs As DirectSound 'Then there is the sub object, DirectSound:
  11.  
  12. Type dxBuffers
  13.   isLoaded As Boolean
  14.   Buffer As DirectSoundBuffer
  15. End Type
  16. Private SoundFolder As String 'Holds Path to Sound folder
  17. Private SB() As dxBuffers 'An Array of BUFFERS,
  18. Private CurrentBuffer As Integer 'Holds last assign Random Buffer Number
  19.  
  20. Public Sub SoundDir(FolderPath As String)
  21.   SoundFolder = FolderPath & "\"
  22. End Sub
  23.  
  24. Public Sub CreateBuffers(AmountOfBuffer As Integer, DefaultFile As String)
  25.   ReDim SB(AmountOfBuffer)
  26.   For AmountOfBuffer = 0 To AmountOfBuffer
  27.     DX7LoadSound AmountOfBuffer, DefaultFile 'must assign a defualt sound
  28.     VolumeLevel AmountOfBuffer, 50 ' set volume to 50% for default
  29.   Next AmountOfBuffer
  30. End Sub
  31.  
  32. Public Sub SetupDX7Sound(CurrentForm As Form)
  33.   Set m_dxs = m_dx.DirectSoundCreate("") 'create a DSound object
  34.  'Next you check for any errors, if there are no errors the user has got DX7 and a functional sound card
  35.  
  36.   If Err.Number <> 0 Then
  37.     MsgBox "Unable to start DirectSound. Check to see that your sound card is properly installed"
  38.     End
  39.   End If
  40.   m_dxs.SetCooperativeLevel CurrentForm.hwnd, DSSCL_PRIORITY 'THIS MUST BE SET BEFORE WE CREATE ANY BUFFERS
  41.   
  42.   'associating our DS object with our window is important. This tells windows to stop
  43.   'other sounds from interfering with ours, and ours not to interfere with other apps.
  44.   'The sounds will only be played when the from has got focus.
  45.   'DSSCL_PRIORITY=no cooperation, exclusive access to the sound card, Needed for games
  46.   'DSSCL_NORMAL=cooperates with other apps, shares resources, Good for general windows multimedia apps.
  47.   
  48. End Sub
  49.  
  50. Public Sub DX7LoadSound(Buffer As Integer, sfile As String)
  51.   Dim Filename As String
  52.   Dim bufferDesc As DSBUFFERDESC  'a new object that when filled in is passed to the DS object to describe
  53.   Dim waveFormat As WAVEFORMATEX 'what sort of buffer to create
  54.   
  55.   bufferDesc.lFlags = DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN _
  56.   Or DSBCAPS_CTRLVOLUME Or DSBCAPS_STATIC 'These settings should do for almost any app....
  57.   
  58.   waveFormat.nFormatTag = WAVE_FORMAT_PCM
  59.   waveFormat.nChannels = 2    '2 channels
  60.   waveFormat.lSamplesPerSec = 22050
  61.   waveFormat.nBitsPerSample = 16  '16 bit rather than 8 bit
  62.   waveFormat.nBlockAlign = waveFormat.nBitsPerSample / 8 * waveFormat.nChannels
  63.   waveFormat.lAvgBytesPerSec = waveFormat.lSamplesPerSec * waveFormat.nBlockAlign
  64.  
  65.   Filename = SoundFolder & sfile
  66.   On Error GoTo Continue
  67.   Set SB(Buffer).Buffer = m_dxs.CreateSoundBufferFromFile(Filename, bufferDesc, waveFormat)
  68.   SB(Buffer).isLoaded = True
  69.   Exit Sub
  70. Continue:
  71.   MsgBox "Error can't find file: " & Filename
  72. End Sub
  73.  
  74. Public Function PlaySoundAnyBuffer(Filename As String, Optional Volume As Byte, Optional PanValue As Byte, Optional LoopIt As Byte) As Integer
  75.   
  76.   Do While SB(CurrentBuffer).Buffer.GetStatus = DSBSTATUS_PLAYING 'Find an empty buffer
  77.     CurrentBuffer = CurrentBuffer + 1
  78.     If CurrentBuffer > UBound(SB) Then CurrentBuffer = 0
  79.   Loop
  80.  
  81.   DX7LoadSound CurrentBuffer, Filename
  82.   If PanValue <> 50 Then PanSound CurrentBuffer, PanValue
  83.   If Volume < 100 Then VolumeLevel CurrentBuffer, Volume
  84.   If SB(CurrentBuffer).isLoaded Then SB(CurrentBuffer).Buffer.Play LoopIt 'dsb_looping=1, dsb_default=0
  85. End Function
  86.  
  87. Public Sub PlaySoundWithPan(Buffer As Integer, Filename As String, Optional Volume As Byte, Optional PanValue As Byte, Optional LoopIt As Byte)
  88.   DX7LoadSound Buffer, Filename
  89.   If PanValue <> 50 And PanValue < 100 Then PanSound Buffer, PanValue
  90.   If Volume < 100 Then VolumeLevel Buffer, Volume
  91.   If SB(Buffer).isLoaded Then SB(Buffer).Buffer.Play LoopIt 'dsb_looping=1, dsb_default=0
  92. End Sub
  93.  
  94. Public Sub PanSound(Buffer As Integer, PanValue As Byte)
  95.   Select Case PanValue
  96.     Case 0
  97.       SB(Buffer).Buffer.SetPan -10000
  98.     Case 100
  99.       SB(Buffer).Buffer.SetPan 10000
  100.     Case Else
  101.       SB(Buffer).Buffer.SetPan (100 * PanValue) - 5000
  102.   End Select
  103. End Sub
  104.  
  105. Public Sub VolumeLevel(Buffer As Integer, Volume As Byte)
  106.   If Volume > 0 Then ' stop division by 0
  107.     SB(Buffer).Buffer.SetVolume (60 * Volume) - 6000
  108.   Else
  109.     SB(Buffer).Buffer.SetVolume -6000
  110.   End If
  111. End Sub
  112.  
  113. Public Function IsPlaying(Buffer As Integer) As Long
  114.   IsPlaying = SB(Buffer).Buffer.GetStatus
  115. End Function
  116.